Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/May/di9805fn/StrTst03.pas

Pascal/Delphi Source File | 1998-01-13 | 10KB | 323 lines

unit StrTst03;
{ Related to my File|New Column on AnsiStrings in Delphi Informant, May, 1998.
  This project demonstrates routines in the HyperString library from
  EFD Systems.  To download the free Delphi 3 *.dcu (HSTR.ZIP) needed
  to run this program, visit their Web Site at www.mindspring.com/~efd.
  Also, be sure to read the paper on AnsiStrings while you're there.
  To report bugs or make suggestions, please E-Mail me at [e-mail].
  Thanks, and enjoy!  Alan C. Moore }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls;

const
MinusNumMask : string = '#09999\.999';

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    StringEntered: TEdit;
    RadioGroup1: TRadioGroup;
    Label2: TLabel;
    StringReturned: TEdit;
    Label3: TLabel;
    NumReturned: TEdit;
    Label4: TLabel;
    SubStr: TEdit;
    Label5: TLabel;
    NumToUse: TEdit;
    SecondNum: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    SubStr2: TEdit;
    TabSheet2: TTabSheet;
    SeachText: TLabel;
    SearchText: TEdit;
    PerformActionsBtn: TButton;
    OpenFileBtn: TButton;
    OpenDialog1: TOpenDialog;
    RadioGroup2: TRadioGroup;
    Memo1: TMemo;
    Label8: TLabel;
    SecondString: TEdit;
    ResultLbl: TLabel;
    ResultField: TEdit;
    procedure RadioGroup1Click(Sender: TObject);
    procedure PerformActionsBtnClick(Sender: TObject);
    procedure OpenFileBtnClick(Sender: TObject);
    procedure RadioGroup2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FirstSubString,
    SecondSubString,
    StringIn,
    StringOut : string;
    Count,
    NumberReturned : Integer;
    FileIsOpen : boolean;
  end;

var
  Form1: TForm1;

implementation
uses HyperStr;
{$R *.DFM}

// First Notebook Page Routine
procedure TForm1.RadioGroup1Click(Sender: TObject);
var
  Start,
  Count : integer;
  RefChar, RefChar2 : char;

  procedure SetCountAsLength;
  begin
    if (SecondNum.text='') OR NOT IsNum(SecondNum.text) then
       Count := Length(StringEntered.Text)
         else
       Count := StrToInt(SecondNum.text);
  end;

  procedure SetCountAs1;
  begin
    if (SecondNum.text='') OR NOT IsNum(SecondNum.text) then
       Count := 1
         else
       Count := StrToInt(SecondNum.text);
  end;

  procedure SetStartAs1;
  begin
    if (NumToUse.text='') OR NOT IsNum(NumToUse.text) then
    Start := 1
      else
    Start := StrToInt(NumToUse.text);
  end;

  procedure SetRefChar;
  begin
    if SubStr.Text='' then
     RefChar := '_'
       else
     RefChar := SubStr.Text[1];
  end;

  function NumCheck: boolean;
  begin
    Result := IsNum(NumToUse.text);
    if NOT Result then
       begin
         MessageDlg('Proper Integer Must be Entered', mtError, [mbOK], 0);
         SetFocusedControl(NumToUse);
       end;
  end;

begin
  if StringEntered.text='' then
    begin
      MessageDlg('No String Entered', mtError, [mbOK], 0);
      Exit;
    end;
  // initialize output fields for some cases
  StringOut := StringEntered.text;
  NumberReturned := 0;
  case RadioGroup1.ItemIndex of    { main case for Page One }
    -1 : exit;
    0:    NumberReturned := MakeNum(StringOut);
    1:    NumberReturned := MakeFloat(StringOut);
    2:    begin
          if NOT NumCheck then Exit;
          Count := StrToInt(NumToUse.text);
          NumberReturned := MakeFixed(StringOut, Count);
          end;
    3:    NumberReturned := MakeAlpha(StringOut);
    4:    NumberReturned := MakeAlphaNum(StringOut);
    5:    begin
            if NOT NumCheck then Exit;
            Count := StrToInt(NumToUse.text);
            RefChar := StringEntered.Text[1];
            StringOut :=  DupChr(RefChar, Count);
           end;
    6:    begin
            SetCountAsLength;
            UCase(StringOut, 1, Count);
          end;
    7:    begin
            SetCountAsLength;
            LCase(StringOut, 1, Count);
           end;
    8:    begin
            StringOut := StringEntered.Text;
            ProperCase(StringOut);
           end;
    9:    begin
            SetStartAs1;
            SetRefChar;
            FillStr(StringOut, Start, RefChar);
          end;
    10:   begin
            SetStartAs1;
            SetCountAs1;
            SetRefChar;
            FillCnt(StringOut, Start, Count, RefChar);
          end;
    11:   NumberReturned := Compact(StringOut);
    12:   begin
            RefChar := StringEntered.Text[1];
            NumberReturned := DeleteC(StringOut, RefChar);
          end;
    13:   begin
            RefChar := StringEntered.Text[1];
            NumberReturned := DeleteD(StringOut, RefChar);
          end;
    14:   begin
            RefChar := StringEntered.Text[1];
            RefChar2 := StringEntered.Text[2];
            ReplaceC(StringOut, RefChar, RefChar2);
          end;
    15:   begin
            FirstSubString :=  SubStr.Text;
            SecondSubString := SubStr2.Text;
            ReplaceS(StringOut, FirstSubString, SecondSubString);
          end;
    16:   RevStr(StringOut);
    17:   begin
            FirstSubString :=  SubStr.Text;
            NumberReturned := DeleteT(StringOut, FirstSubString);
            ReplaceS(StringOut, FirstSubString, SecondSubString);
          end;
    18:   begin
            FirstSubString :=  SubStr.Text;
            SecondSubString := SubStr2.Text;
            ReplaceT(StringOut, FirstSubString, SecondSubString[1]);
          end;
    19:   begin
            FirstSubString :=  SubStr.Text;
            SecondSubString := SubStr2.Text;
            Translate(StringOut, FirstSubString, SecondSubString);
          end;

  end;    { Main Page One case }
  StringReturned.Text := StringOut;
  NumReturned.Text := IntToStr(NumberReturned);
end;

procedure TForm1.PerformActionsBtnClick(Sender: TObject);
begin
  if SearchText.Text='' then
  begin
    MessageDlg('Search Text Must be Entered', mtError, [mbOK], 0);
    Exit;
  end;
  RadioGroup2Click(RadioGroup2);
end;

procedure TForm1.OpenFileBtnClick(Sender: TObject);
var
J : integer;
  begin
    StringIn := '';
    if OpenDialog1.Execute then begin
    FileIsOpen := true;
    Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
    for j := 0 to Memo1.Lines.Count-1 do    { Iterate }
    begin
      StringIn := Concat(StringIn, Memo1.Lines[j]) ;
    end;    { for }

  end;

end;

procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
// first case checks for errors of ommision
case RadioGroup2.ItemIndex of    { general testing case  }
  -1: Exit;
   0..2:  if ((SearchText.Text='') or (SecondString.Text='')) then
             begin
               MessageDlg('Text Must be Entered in both Edit Fields', mtError, [mbOK], 0);
               Exit;
             end;
   3..11:   begin
             if NOT FileIsOpen then
             begin
               MessageDlg('No File Open', mtError, [mbOK], 0);
               Exit;
             end;
             if SearchText.Text='' then
              begin
               MessageDlg('No Search Text Entered', mtError, [mbOK], 0);
               Exit;
              end;
             end;
end;    { general testing case }

case RadioGroup2.ItemIndex of   { specific testing case  }
     3,5,6,7,8,9: if NOT IsNum(SecondString.Text) then
             begin
               MessageDlg('Number must be entered in Second String', mtError, [mbOK], 0);
               Exit;
             end;
     4,10,11:   if NOT IsMask(SecondString.Text,
                  MinusNumMask,-1) then
             begin
               MessageDlg('Integer or -1 must be entered in Second String', mtError, [mbOK], 0);
               Exit;
             end;




end;    {  specific testing case   }

case RadioGroup2.ItemIndex of    { main case  }
  0: ResultField.Text := IntToStr(Similar(Sear